home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / IFF / double_buffer2 < prev    next >
Encoding:
Text File  |  1996-12-15  |  3.6 KB  |  227 lines
  1. \ Fast Double Buffering
  2. \ Open a Screen with a backdrop window,
  3. \ Init two views and use them for buffering.
  4. \ Provide word to switch display/drawing surface.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1990 Phil Burk
  8. \
  9. \ 00001 PLB 9/23/91 Use DBUF-WINDOWS rastport
  10. \ 00002 PLB 1/24/92 Changed name of ERROR locals to ERROR?, so no conflict.
  11.  
  12. getmodule includes
  13. include? choose ju:random
  14. include? bitmap>screen ju:screen_support
  15.  
  16. ANEW TASK-Double_Buffer
  17.  
  18. variable DBUF-VIEW0
  19. variable DBUF-VIEW1
  20.  
  21. variable DBUF-BITMAP0
  22. variable DBUF-BITMAP1
  23.  
  24. variable DBUF-SCREEN
  25. variable DBUF-WINDOW
  26.  
  27. variable DBUF-RASTPORT
  28.  
  29. variable DBUF-CUR-BUF  \ 0 or 1 for currently DISPLAYED "buffer"
  30.  
  31. : DBUF.UNMAKE.VIEWS  ( -- )
  32.     dbuf-view0 @ ?dup
  33.     IF
  34.         free.view
  35.         dbuf-view0 off
  36.     THEN
  37. \
  38.     dbuf-view1 @ ?dup
  39.     IF
  40.         free.view
  41.         dbuf-view1 off
  42.     THEN
  43. ;
  44.  
  45. : DBUF.UNMAKE  ( -- close and free everything )
  46.     dbuf-window @ ?dup
  47.     IF    dup gr-curwindow @ =
  48.         IF
  49.             drop GR.CloseCurW
  50.         ELSE
  51.             gr.CloseWindow
  52.         THEN
  53.         dbuf-window off
  54.     THEN
  55. \
  56.     dbuf-screen @ ?dup
  57.     IF    CloseScreen()
  58.         dbuf-screen off
  59.     THEN
  60. \
  61.     dbuf-bitmap0 @ ?dup
  62.     IF    Free.Bitmap
  63.         dbuf-bitmap0 off
  64.     THEN
  65. \
  66.     dbuf-bitmap1 @ ?dup
  67.     IF    Free.Bitmap
  68.         dbuf-bitmap1 off
  69.     THEN
  70.  
  71.     dbuf.unmake.views
  72. ;
  73.  
  74.  
  75. : DBUF.MAKE0  { bdepth bwidth bheight camg | error? -- error? , first buffer }
  76.     dbuf.unmake
  77.     true -> error?
  78.     bdepth bwidth bheight
  79.     alloc.bitmap   ?dup
  80.     IF
  81.         dup dbuf-bitmap0 !
  82.         camg bitmap>screen  ?dup
  83.         IF
  84.             dup dbuf-screen !
  85.             screen>backwindow ?dup
  86.             IF
  87.                 dbuf-window !
  88.                 0 dbuf-cur-buf !
  89.                 dbuf-window @ s@ wd_rport dbuf-rastport ! \ 00001
  90.                 false -> error?
  91.             THEN
  92.         THEN
  93.     THEN
  94.     error? dup
  95.     IF dbuf.unmake
  96.     THEN
  97. ;
  98.  
  99. : DBUF.SELECT.BITMAP ( 0|1 -- bitmap )
  100.     IF
  101.         dbuf-bitmap1 @ dup 0=
  102.         IF
  103.             drop dbuf-bitmap0 @
  104.         THEN
  105.     ELSE dbuf-bitmap0 @
  106.     THEN
  107.     dup 0= abort" DBUF.SELECT.BITMAP - found no bitmap!"
  108. ;
  109.  
  110. : DBUF_DRAWING_BITMAP ( -- bitmap )
  111.     dbuf-cur-buf @ 1 xor dbuf.select.bitmap
  112.  
  113. ;
  114. : DBUF_SHOWING_BITMAP ( -- bitmap )
  115.     dbuf-cur-buf @ dbuf.select.bitmap
  116. ;
  117.  
  118. : DBUF.DRAWTO  ( 0|1 -- , draw to that bitmap )
  119.     dbuf.select.bitmap
  120.     dbuf-rastport @ link.bm>rp
  121.     dbuf-rastport @ >abs gr-currport !
  122. ;
  123.  
  124. : DBUF.DISPLAY ( 0|1 -- , display that view )
  125.     IF dbuf-view1 @
  126.     ELSE dbuf-view0 @
  127.     THEN
  128.     LoadView()
  129. ;
  130.  
  131. : DBUF.SWITCH  ( -- , switch between double buffers )
  132.     dbuf-cur-buf @
  133.     dup 1 xor dup dbuf-cur-buf !
  134.     dbuf.display
  135.     dbuf.drawto
  136. ;
  137.  
  138. : DBUF.MAKE.VIEW  ( bitmap -- view | 0 , use bitmap in screen, make view)
  139.     dbuf-screen @ .. sc_bitmap
  140.     copy.planes
  141.     dbuf-screen @ remake.screen
  142. \
  143. \ now make view for it
  144.     dbuf-screen @ screen>view
  145. >newline ." DBUF.MAKE.VIEW: " dup . cr
  146. ;
  147.  
  148. : DBUF.MAKE.VIEWS  ( -- error? , make views for both buffers )
  149.     dbuf.unmake.views
  150.     true  \ default error flag
  151.     dbuf-bitmap0 @ dbuf.make.view ?dup
  152.     IF    dbuf-view0 !
  153. \
  154.         dbuf-bitmap1 @ dbuf.make.view ?dup
  155.         IF    dbuf-view1 !
  156.             drop false \ return value
  157.         THEN
  158.     THEN
  159.     dup
  160.     IF dbuf.unmake.views
  161.     THEN
  162. ;
  163.  
  164. : DBUF.MAKE1  { bdepth bwidth bheight | error? -- error? , second buffer }
  165.     true -> error?
  166.     bdepth bwidth bheight
  167.     alloc.bitmap   ?dup
  168.     IF
  169.         dbuf-bitmap1 !
  170. \        alloc.rastport ?dup \ 00001
  171. \        IF  dbuf-rastport !
  172.             1 dbuf.drawto
  173.             dbuf.make.views -> error?
  174. error? IF
  175. >newline ." error = " error? . cr
  176. THEN
  177.  
  178. \        THEN
  179.  
  180. ELSE >newline ." no bitmap?" cr
  181.     THEN
  182. \
  183.     error? dup
  184.     IF dbuf.unmake
  185.     THEN
  186. ;
  187.  
  188. if.forgotten dbuf.unmake
  189.  
  190. 1 .IF
  191. \ test double buffering
  192. : T1
  193.     graphics?
  194.     4 320 200 0 dbuf.make0
  195. ;
  196. : T2
  197.     4 320 200 dbuf.make1
  198. ;
  199.  
  200. : TDRAW ( -- draw )
  201.     gr.clear
  202.     50 50 gr.move
  203.     60 0
  204.     DO 16 choose gr.color!
  205.         320 choose 200 choose gr.draw
  206.     LOOP
  207. ;
  208.  
  209. : TLOOP ( -- )
  210.     dbuf.switch
  211.     BEGIN
  212.         tdraw  dbuf.switch
  213.         ?terminal
  214.     UNTIL
  215. ;
  216.  
  217. : TEST
  218.     t1 abort" t1 failed"
  219.     t2 abort" t2 failed"
  220.     tloop
  221.     dbuf.unmake
  222. ;
  223.  
  224.  
  225. .THEN
  226.  
  227.